RxR - una Regione per Restare commissioned a research project on economic inequality in Italy, with a specific focus Umbria, its main region of interest. The complete report is available at report link (in Italian), while the source code is available on github.
Below is a selection of the data visualization work involved (translated to English). The project was conducted using R, interactive plots and maps are realised using the ggiraph package.
Mapping inequality and poverty
Show code
##### import sfregMap <-readRDS('regMap.rds')##### merge Gini tibbles with sf dataincMap <-left_join(giniInc, regMap, by =join_by(stratum == DEN_REG))##### ggiraph ready mapincGiniGG <- incMap |>filter(year ==2000| year ==2010|year ==2020) |>drop_na(rank) |>ggplot() +geom_sf_interactive(aes(geometry = geometry, fill = value, data_id = stratum, tooltip = value), colour ='black') +facet_wrap(vars(year)) +labs(x =NULL, y =NULL,title ='Gini index by region',subtitle ='Equivalent household income',caption ='Data: Bank of Italy. Elaborated by Lorenzo Mattioli - Una Regione per Restare') +theme_minimal(base_family ='Helvetica') +scale_fill_viridis_c(direction =-1, limits =c(15, 40), option ='mako') +theme(axis.text.x=element_blank(),axis.ticks.x=element_blank(),axis.text.y=element_blank(),axis.ticks.y=element_blank(),panel.grid =element_blank(),legend.title =element_blank(),plot.title =element_text(size =15,hjust = .5),plot.subtitle =element_text(hjust = .5),plot.caption =element_text(size =9,hjust = .5))##### interactive mapgirafe(ggobj = incGiniGG,width_svg =13,options =list(opts_hover(css =''), ## CSS code of line we're hovering overopts_hover_inv(css ="opacity:0.3;"), ## CSS code of all other linesopts_tooltip(css ="background-color:white; color:black; font-family:Helvetica; font-style:empty; padding:8px; border-radius:10px;",use_cursor_pos = T),opts_toolbar(position ='bottomright') ))
Show code
pov$ireg <-gsub(' - ', '-', pov$ireg)povMap <-left_join(pov, regMap, by =join_by(ireg == DEN_REG))##### ggiraph ready mappovMap$hCount <-round(povMap$hCount*100, 2)povhGG <- povMap |>filter(anno ==2000| anno ==2010|anno ==2020) |>ggplot() +geom_sf_interactive(aes(geometry = geometry, fill = hCount, data_id = ireg, tooltip = hCount), colour ='black') +facet_wrap(vars(anno)) +labs(x =NULL, y =NULL,title ='Poverty headcount by region',caption ='Data: Bank of Italy. Elaborated by Lorenzo Mattioli - Una Regione per Restare') +theme_minimal(base_family ='Helvetica') +scale_fill_viridis_c(direction =-1, limits =c(0, 51), option ='inferno') +theme(axis.text.x=element_blank(),axis.ticks.x=element_blank(),axis.text.y=element_blank(),axis.ticks.y=element_blank(),panel.grid =element_blank(),legend.title =element_blank(),plot.title =element_text(size =15,hjust = .5),plot.subtitle =element_text(hjust = .5),plot.caption =element_text(size =9,hjust = .5))##### interactive mapgirafe(ggobj = povhGG,width_svg =13,options =list(opts_hover(css =''), ## CSS code of line we're hovering overopts_hover_inv(css ="opacity:0.3;"), ## CSS code of all other linesopts_tooltip(css ="background-color:white; color:black; font-family:Helvetica; font-style:empty; padding:8px; border-radius:10px;",use_cursor_pos = T),opts_toolbar(position ='bottomright') ))
Ranking regions by inequality indexes and poverty
Show code
# GiniginiInc |>filter(year ==2000| year ==2004| year ==2008| year ==2012| year ==2016| year ==2020) |>drop_na(rank) |>ggplot(aes(x = year, y = rank, data_id = stratum)) +geom_bump(linewidth =0.6, color ='gray90',data =~. |>filter(stratum !='Umbria')) +geom_bump(aes(colour = stratum), linewidth =0.8,data =~. |>filter(stratum =='Umbria'| stratum =='Lombardia'| stratum =='Abruzzo')) +geom_point(color ='gray90',data =~. |>filter(stratum !='Umbria'),size =4) +geom_point(aes(colour = stratum),data =~. |>filter(stratum =='Umbria'| stratum =='Lombardia'| stratum =='Abruzzo'),size =4) +geom_point(color ='white', size =2) +geom_text_interactive(aes(label = stratum, group = stratum), colour ='gray90', x =2021, hjust =0, size =3.5, family ='Helvetica',data =~. |>filter(year ==2020)) +geom_text(aes(label = stratum, group = stratum), colour ='black', x =2021, hjust =0,, size =3.5, family ='Helvetica',data =~. |>filter(year ==2020& stratum =='Umbria'| year ==2020& stratum =='Lombardia'| year ==2020& stratum =='Abruzzo')) +scale_color_viridis_d(option ='mako', end = .6) +scale_x_continuous(limits =c(2000, 2024) ,expand =c(0.01, 0), breaks=c(2000, 2004, 2008, 2012, 2016, 2020)) +scale_y_reverse(expand =c(0.02, 0), breaks =c(5, 10, 15, 20)) +labs(x =NULL, y =NULL,title ='Ranking Italian regions by Gini index',subtitle ='Equivalent household income',caption ='Data: Bank of Italy. Elaborated by Lorenzo Mattioli - Una Regione per Restare') +theme_minimal(base_family ='Helvetica') +theme(legend.position ='none',panel.grid =element_blank(),plot.title =element_text(size =15,hjust = .5),plot.subtitle =element_text(hjust = .5),plot.caption =element_text(size =8,hjust = .5) )# Povertypov |>filter(anno ==2000| anno ==2004| anno ==2008| anno ==2012| anno ==2016| anno ==2020) |>ggplot(aes(x = anno, y = rankHCount, group = ireg, data_id = ireg)) +geom_bump(linewidth =0.6, color ="gray90", smooth =6) +geom_bump(aes(colour = ireg), linewidth =0.8, smooth =6,data =~. |>filter(ireg =='Umbria'| ireg =='Lombardia'| ireg =='Abruzzo')) +geom_point(color ="gray90", size =4) +geom_point(aes(colour = ireg),data =~. |>filter(ireg =='Umbria'| ireg =='Lombardia'| ireg =='Abruzzo'),size =4) +geom_point(color ='white', size =2) +geom_text(aes(label = ireg, group = ireg), colour ='gray90', x =2021, hjust =0, size =3.5, family ='Helvetica',data =~. |>filter(anno ==2020)) +geom_text(aes(label = ireg, group = ireg), colour ='black', x =2021, hjust =0,, size =3.5, family ='Helvetica',data =~. |>filter(anno ==2020& ireg =='Umbria'| anno ==2020& ireg =='Lombardia'| anno ==2020& ireg =='Abruzzo')) +scale_color_manual(values =met.brewer('Degas')) +scale_x_continuous(limits =c(2000, 2030) ,expand =c(0.01, 0), breaks=c(2000, 2010, 2020)) +scale_y_reverse(expand =c(0.02, 0), breaks =c(1, 5, 10, 15, 20)) +labs(x =NULL, y =NULL,title ='Ranking Italian regions by poverty rate',subtitle ='Headcount, from poorest to least poor',caption ='Data: Bank of Italy. Elaborated by Lorenzo Mattioli - Una Regione per Restare') +theme_minimal(base_family ='Helvetica') +theme(legend.position ='none',panel.grid =element_blank(),plot.title =element_text(size =15,hjust = .5),plot.subtitle =element_text(hjust = .5),plot.caption =element_text(size =8,hjust = .5) )
Investigating causes of poverty through LPM modeling
Show code
lpmresults$vars <-factor(lpmresults$vars, levels=unique(lpmresults$vars))lpmresults$roundEst <-round(lpmresults$Estimate, 2)gglpm <- lpmresults |>filter(vars =='Titolo di studio') |>ggplot(aes(x=Estimate, y=reg, colour = vars, data_id = roundEst, tooltip = roundEst)) +geom_vline(xintercept =0,linewidth =0.4,color ='gray70') +geom_linerange_interactive(aes(xmin=`2.5 %`,xmax=`97.5 %`), linewidth = .6) +geom_point_interactive(size =4) +geom_point(colour ='white', size =2) +geom_point_interactive(aes(x =`2.5 %`), shape ='|', size =4) +geom_point_interactive(aes(x =`97.5 %`), shape ='|', size =4) +labs(x =NULL, y =NULL,title ='Probability of falling below relative poverty line based on head of household\'s educational attainment',subtitle ='Reference category: post-lauream specialisation',caption ='Data: Bank of Italy. Elaborated by Lorenzo Mattioli - Una Regione per Restare') +scale_color_manual(values =met.brewer('Degas')) +theme_minimal(base_family ='Helvetica') +theme(panel.grid =element_line(),legend.position ='none',plot.title =element_text(size =15,hjust =1),plot.subtitle =element_text(hjust =-.065),plot.caption =element_text(size =8,hjust = .5))girafe(ggobj = gglpm,width_svg =13,options =list(opts_hover(css =''), ## CSS code of line we're hovering overopts_hover_inv(css ="opacity:0.3;"), ## CSS code of all other linesopts_tooltip(css ="background-color:white; color:black; font-family:Helvetica; font-style:empty; padding:8px; border-radius:10px;",use_cursor_pos = T),opts_toolbar(position ='bottomright')))